home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / OPUS_173.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-20  |  12KB  |  355 lines
  1. UNIT Opus_173;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Opus 1.73+ support routiner                   Last changed: 20.04.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-93 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                          Birger  Kristensen                              ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, OproUtil, PoPTypes;
  16.  
  17. TYPE
  18.   Version7NlType = RECORD
  19.                      Zone,
  20.                      Net,
  21.                      Node,
  22.                      HubNode:   Integer;
  23.                      CallCost,         { phone company's charge }
  24.                      MsgFee,           { Amount charged to user for a message }
  25.                      NodeFlags: Word;  { set of flags (see below) }
  26.                      ModemType,        { RESERVED for modem type }
  27.                      Phone_Len,
  28.                      Password_Len,
  29.                      BName_Len,
  30.                      SName_Len,
  31.                      CName_Len,
  32.                      Pack_Len,
  33.                      BaudRate:  Byte;   { baud rate divided by 300 }
  34.                    END;
  35.  
  36. (*
  37. #define B_hub    0x0001  /* node is a net hub     0000 0000 0000 0001 */
  38. #define B_host   0x0002  /* node is a net host    0000 0000 0000 0010 */
  39. #define B_region 0x0004  /* node is region coord  0000 0000 0000 0100 */
  40. #define B_zone   0x0008  /* is a zone gateway     0000 0000 0000 1000 */
  41. #define B_CM     0x0010  /* runs continuous mail  0000 0000 0001 0000 */
  42. #define B_res1   0x0020  /* reserved by Opus      0000 0000 0010 0000 */
  43. #define B_res2   0x0040  /* reserved by Opus      0000 0000 0100 0000 */
  44. #define B_res3   0x0080  /* reserved by Opus      0000 0000 1000 0000 */
  45. #define B_res4   0x0100  /* reserved by Opus      0000 0001 0000 0000 */
  46. #define B_res5   0x0200  /* reserved for non-Opus 0000 0010 0000 0000 */
  47. #define B_res6   0x0400  /* reserved for non-Opus 0000 0100 0000 0000 */
  48. #define B_res7   0x0800  /* reserved for non-Opus 0000 1000 0000 0000 */
  49. #define B_point  0x1000  /* node is a point       0001 0000 0000 0000 */
  50. #define B_res9   0x2000  /* reserved for non-Opus 0010 0000 0000 0000 */
  51. #define B_resa   0x4000  /* reserved for non-Opus 0100 0000 0000 0000 */
  52. #define B_resb   0x8000  /* reserved for non-Opus 1000 0000 0000 0000 */
  53. *)
  54.   PFileSys = ^TFileSys;
  55.   TFileSys = RECORD
  56.               Area_Name     : S32;
  57.               Area_Number,
  58.               Area_Menu,
  59.               Total_Size    : Word;
  60.               Area_Priv,
  61.               Down_Priv,
  62.               Up_Priv,
  63.               Priv_Up,
  64.               Ratio_Priv,
  65.               New_Priv      : Byte;
  66.               Attrib,
  67.               Status        : Word;
  68.               StartPos,
  69.               Area_Lock,
  70.               Up_Lock,
  71.               Down_Lock,
  72.               Priv_Key,
  73.               Section       : LongInt;
  74.               Other_Len,
  75.               Def_Upload,
  76.               Priv_Upload,
  77.               Key_Upload    : Word;
  78.               Title,
  79.               PreFiles,
  80.               DownPath,
  81.               UpPath,
  82.               Barricade,
  83.               ListPath,
  84.               PrivKey,
  85.               PrivUp,
  86.               Menu,
  87.               Volume,
  88.               Help          : String;
  89.             END;
  90.  
  91.   _PFileSys = ^_TFileSys;
  92.   _TFileSys = RECORD
  93.                Area_Name   : Array[1..32] of Char;
  94.                Area_Number,
  95.                Area_Menu,
  96.                Total_Size  : Word;
  97.                Area_Priv,
  98.                Down_Priv,
  99.                Up_Priv,
  100.                Priv_Up,
  101.                Ratio_Priv,
  102.                New_Priv    : Byte;
  103.                Fill_Byte1  : Array[1..2] of Byte;
  104.                Attrib,
  105.                Status      : Word;
  106.                StartPos,
  107.                Area_Lock,
  108.                Up_Lock,
  109.                Down_Lock,
  110.                Priv_Key,
  111.                Section     : LongInt;
  112.                Fill_Long   : Array[1..2] of LongInt;
  113.                Title_Len,
  114.                PreFiles_Len,
  115.                Downpath_Len,
  116.                Uppath_Len,
  117.                Barricade_Len,
  118.                ListPath_Len,
  119.                PrivKey_Len,
  120.                PrivUp_Len,
  121.                Menu_Len,
  122.                Vol_Len,
  123.                Help_Len      : Byte;
  124.                Fill_Byte2    : Array[1..5] of Byte;
  125.                Other_Len,
  126.                Def_Upload,
  127.                Priv_Upload,
  128.                Key_Upload    : Word;
  129.                Fill_Word     : Array[1..10] of Word;
  130.              END;
  131.  
  132.   FilesBBSType = RECORD
  133.     Area_Number : Word;
  134.     Name        : String[12];
  135.     Dl_Priv     : Byte;
  136.     Size        : LongInt;
  137.     Date        : Word;
  138.     Time        : Word;
  139.     AFlag       : Word;
  140.     DL_Lock     : LongInt;
  141.     Up_Date     : Word;
  142.     Up_Time     : Word;
  143.     Down_Cntr   : Word;
  144.     Descr_Len   : Word;
  145.     AltPath_Len : Byte;
  146.     Upld_by_Len : Byte;
  147.     Nxt_Key     : LongInt;
  148.     Filler      : Array[1..20] of Byte;  { Size = 64 bytes }
  149.     Description : String;
  150.     AltPath     : PathStr;
  151.     Uploaded_By : String[35];
  152.   END;
  153. (*
  154. typedef struct _numb_idx {      /* Structure for FILESBBS.ADX */
  155.     word    area_number;    /* area number where files reside */
  156.     byte    area_priv;  /* Access priv */
  157.     byte    filler;  /* To keep it aligned */
  158.     long    area_lock;  /* Access lock */
  159.     long    pos;        /* start of area in FILESBBS.DAT */
  160.     long    insert_pos;        /* where to insert new files    */
  161.     word    nflag;        /* flags for this area        */
  162. } ANUMB;
  163. *)
  164.  
  165.   FilesBBSNumIdx = RECORD
  166.     Area_Number : Word;
  167.     Area_Priv   : Byte;
  168.     Filler      : Byte;
  169.     Area_Lock   : LongInt;
  170.     Offset      : LongInt;
  171.     Insert_Pos  : LongInt;
  172.     NFlag       : Word;
  173.   END;
  174.  
  175. FUNCTION Address2Opus(CONST Address: TFidoAddress): S8;
  176. FUNCTION FancyStr(s: String): String;
  177. FUNCTION UnPack(CONST InStr: String): String;
  178. FUNCTION Pack(InStr: String): String;
  179.  
  180. procedure ReadOneFilesBBSLine(VAR f: TBufTextFile; VAR FileRec: FilesBBSType);
  181. PROCEDURE ReadNextFileArea(VAR FSFile: TBufTextFile; VAR FileSysRec: TFileSys);
  182. FUNCTION  FindAreaByNumber(CONST BBSPath: PathStr; AreaNumber: Word; VAR Offset: LongInt): Boolean;
  183. FUNCTION  FindAreaByPath(CONST BBSPath, Path: PathStr; VAR Offset: LongInt): Boolean;
  184.  
  185. IMPLEMENTATION
  186.  
  187. USES OpString, OpRoot,
  188.      StrUtil, NetFile;
  189.  
  190. CONST
  191.   unwrk : String[40] = ' EANROSTILCHBDMUGPKYWFVJXZQ-''0123456789';
  192.  
  193. TYPE
  194.   UType = RECORD
  195.             CASE Byte OF
  196.               1: (w1    : Word);
  197.               2: (c1,c2 : Char);
  198.           END;
  199.  
  200.   FUNCTION Address2Opus(CONST Address: TFidoAddress): S8;
  201.   VAR
  202.     s : S8;
  203.   BEGIN
  204.     WITH Address DO
  205.       s:=Char(Lo(Zone))+Char(Hi(Zone))+Char(Lo(Net))+Char(Hi(Net))+
  206.          Char(Lo(Node))+Char(Hi(Node))+Char(Lo(Point))+Char(Hi(Point));
  207.     IF Address.Point=0 THEN s:=Copy(s,1,6);
  208.     Address2Opus:=s;
  209.   END;
  210.  
  211.   FUNCTION FancyStr(s: String): String;
  212.   VAR
  213.     i : Byte;
  214.   BEGIN
  215.     s:=StLoCase(s);
  216.     FOR i:=1 TO Length(s) DO
  217.       IF (i=1) Or (s[i-1]=' ') THEN s[i]:=UpCase(s[i]);
  218.     FancyStr:=s;
  219.   END;
  220.  
  221.   FUNCTION UnPack(CONST InStr: String): String;
  222.   VAR
  223.     OutStr : String;
  224.     OBuf : String[4];
  225.     Count,i,j : Byte;
  226.     u : UType;
  227.   BEGIN
  228.     OutStr:=''; Count:=1;
  229.     WHILE Count<=Length(InStr) DO
  230.     BEGIN
  231.       u.c1:=InStr[Count]; u.c2:=InStr[Count+1];
  232.       Inc(Count,2);
  233.       FOR j:=3 DOWNTO 1 DO
  234.       BEGIN
  235.         i:=u.w1 Mod 40;
  236.         u.w1:=u.w1 Div 40;
  237.         OBuf[j]:=unwrk[i+1];
  238.       END;
  239.       OBuf[0]:=#3;
  240.       OutStr:=OutStr+OBuf;
  241.     END;
  242.     UnPack:=OutStr;
  243.   END;
  244.  
  245.   FUNCTION Pack(InStr: String): String;
  246.   VAR
  247.     u : UType;
  248.     i,j,Cnt : Byte;
  249.     s : String;
  250.   BEGIN
  251.     u.w1:=0; cnt:=0; u.w1:=0; s:='';
  252.     InStr:=stupcase(InStr)+CharStr(' ',3-(Length(InStr) Mod 3)); { Indsat BK'95 }
  253.     FOR i:=1 TO Length(InStr) DO
  254.     BEGIN
  255.       j:=Pos(InStr[i],unwrk);
  256.       IF j=0 THEN j:=1;
  257.       u.w1:=u.w1*40+(j-1);
  258.       Inc(Cnt);
  259.       IF Cnt=3 THEN
  260.       BEGIN
  261.         s:=s+u.c1+u.c2;
  262.         u.w1:=0;
  263.         Cnt:=0;
  264.       END;
  265.     END;
  266. { ????
  267.     IF Cnt>0 THEN s:=s+u.c1+u.c2;
  268. }
  269.     Pack:=s;
  270.   END;
  271.  
  272.  
  273. {=== FilesBBS support routiner ==============================================}
  274.  
  275.   procedure ReadOneFilesBBSLine(VAR f: TBufTextFile; VAR FileRec: FilesBBSType);
  276.   begin
  277.     FillChar(FileRec, SizeOf(FileRec), 0);
  278.     f.Read(FileRec, 64);
  279.     f.ReadLenStr(FileRec.Description, FileRec.Descr_Len);
  280.     f.ReadLenStr(FileRec.AltPath, FileRec.AltPath_Len);
  281.     f.ReadLenStr(FileRec.Uploaded_By, FileRec.Upld_by_Len);
  282.     FileRec.Name:=AsciiZ2Str(FileRec.Name[0],12);
  283.   end;
  284.  
  285.   PROCEDURE ReadNextFileArea(VAR FSFile: TBufTextFile; VAR FileSysRec: TFileSys);
  286.   VAR
  287.     _FileSysRec : _PFileSys;
  288.   BEGIN
  289.     New(_FileSysRec);
  290.     FillChar(_FileSysRec^, SizeOf(_FileSysRec^), 0);
  291.     FillChar(FileSysRec, SizeOf(FileSysRec), 0);
  292.  
  293.     FSFile.Read(_FileSysRec^,SizeOf(_FileSysRec^));
  294.  
  295.     Move(_FileSysRec^.Area_Number, FileSysRec.Area_Number, 12);
  296.     Move(_FileSysRec^.Attrib, FileSysRec.Attrib, 28);
  297.     Move(_FileSysRec^.Other_Len, FileSysRec.Other_Len, 8);
  298.  
  299.     FSFile.ReadLenStr(FileSysRec.Title,_FileSysRec^.Title_Len);
  300.     FSFile.ReadLenStr(FileSysRec.PreFiles,_FileSysRec^.PreFiles_Len);
  301.     FSFile.ReadLenStr(FileSysRec.Downpath,_FileSysRec^.DownPath_Len);
  302.     FSFile.ReadLenStr(FileSysRec.Barricade,_FileSysRec^.Barricade_Len);
  303.     FSFile.ReadLenStr(FileSysRec.ListPath,_FileSysRec^.ListPath_Len);
  304.     FSFile.ReadLenStr(FileSysRec.Menu,_FileSysRec^.Menu_Len);
  305.     FSFile.ReadLenStr(FileSysRec.Help,_FileSysRec^.Help_Len);
  306.     FSFile.ReadLenStr(FileSysRec.UpPath,_FileSysRec^.UpPath_Len);
  307.     FSFile.ReadLenStr(FileSysRec.PrivUp,_FileSysRec^.PrivUp_Len);
  308.     FSFile.ReadLenStr(FileSysRec.PrivKey,_FileSysRec^.PrivKey_Len);
  309.     FSFile.ReadLenStr(FileSysRec.Volume,_FileSysRec^.Vol_Len);
  310.     Dispose(_FileSysRec);
  311.   END;
  312.  
  313.   FUNCTION FindAreaByNumber(CONST BBSPath: PathStr; AreaNumber: Word; VAR Offset: LongInt): Boolean;
  314.   VAR
  315.     f : TNetFile;
  316.     Found : Boolean;
  317.     FilesBBSNumIdxRec : FilesBBSNumIdx;
  318.   BEGIN
  319.     FindAreaByNumber:=False;
  320.     IF f.Open(AddBackSlash(BBSPath)+'FILESBBS.ADX', SizeOf(FilesBBSNumIdx), False) THEN
  321.     BEGIN
  322.       Found:=False;
  323.       REPEAT
  324.         f.Read(FilesBBSNumIdxRec,NoKeep,Wait);
  325.         Found:=(FilesBBSNumIdxRec.Area_Number=AreaNumber)
  326.       UNTIL f.Eof Or (Found);
  327.       Offset:=FilesBBSNumIdxRec.Offset;
  328.       FindAreaByNumber:=Found;
  329.       f.Close;
  330.     END;
  331.   END;
  332.  
  333.   FUNCTION FindAreaByPath(CONST BBSPath, Path: PathStr; VAR Offset: LongInt): Boolean;
  334.   VAR
  335.     f           : TBufTextFile;
  336.     SysFileRec  : PFileSys;
  337.     Found       : Boolean;
  338.   BEGIN
  339.     Found:=False; Offset:=0;
  340.     IF f.Init(AddBackSlash(BBSPath)+'SYSFILE.DAT', SOpenRead+ShareDenyNone, 10240) THEN
  341.     BEGIN
  342.       New(SysFileRec);
  343.       WHILE Not F.Eof AND NOT Found DO
  344.       BEGIN
  345.         ReadNextFileArea(F, SysFileRec^);
  346.         Found:=StUpCase(AddBackSlash(SysFileRec^.DownPath))=StUpCase(AddBackSlash(Path));
  347.       END;
  348.       f.Done;
  349.       IF Found THEN Found:=FindAreaByNumber(BBSPath, SysFileRec^.Area_Number, Offset);
  350.       Dispose(SysFileRec);
  351.     END;
  352.   END;
  353.  
  354. END.
  355.